Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / b / k11rt4.mac < prev next >

Wrap

Text File | 1989-06-12 | 27.0 KB | 1,117 lines

.title k11rt4 i/o for rt11 version 4 or 5 for Kermit-11 .ident /1.0.01/ ; 08-Mar-84 09:18:25 Brian Nelson ; ; 6-May-85 Added a little more to the TSX message to ; indicate that the TSX version comes up in ; the remote mode. If a set line 0 is performed ; you are changed to a local kermit and send ; receive do not work. Going to server mode ; works fine. Purpose of the message is to alert ; user that the default is remote mode and no ; setting of the line is required. ; ; 20-May-86 09:03:30 Mods for .SETTOP in XM, also .SERR mods ; ; Copyright (C) 1984 1986 Change Software, Inc. ; ; This is the RT11 version of K11RMS.MAC. It simply tries ; to emulate, as much as is reasonable, what the RMS i/o ; routines do for RSX and RSTS. This strains a few things ; in as much that RT11 does not provide much of anything ; in the sense of file services as compared to that which ; RMS11 v2 provides. Since the whole of Kermit-11 is built ; around RMS11 for i/o we will even take the step to map ; RT11 error codes into RMS11 error codes, thus allowing ; the use of the RMS error routines and removing any need ; to modify Kermit-11 elsewhere. ; We won't really use the RMS error routines since they are ; much to comprehensive for the errors that RT can have. ; ; This routine MUST be in the root segment. ; The RT11 executive must have multiple terminal support. ; ; ; Disk i/o epts ; ; open ( %loc filename, %val channel_number ,%val type ) ; create( %loc filename, %val channel_number ,%val type ) ; getrec( %loc buffer , %val channel_number ) { returns RSZ in R1} ; putrec( %loc buffer , %val record_size ,%val channel_number ) ; close ( %val channel_number ) ; putc ( %val char , %val channel_number ) ; getc ( %val channel_number ) .sbttl non disk i/o entry points ; In all cases, R0 will have the returned error code (zero for success) ; For KBREAD and READ, R1 will have the size of the read ; For BINREAD, R1 will have the character just read ; ; The use of %LOC and %VAL are from VMS Pascal and Fortran. ; %LOC means ADDRESS, whereas %VAL means literal. All call ; formats assume the first argument is at 0(r5), the next ; at 2(r5) and so on, as in: ; ; clr -(sp) ; today's date by default ; mov #datebf ,-(sp) ; where to put the converted string ; mov sp ,r5 ; call ASCDAT ; call ascdat ; simple ; cmp (sp)+ ,(sp)+ ; all done ; ; or by using the CALLS macro (defined in K11MAC.MAC) ; ; calls ascdat ,<#datebf,#0> ; ; ; Any version of Kermit-11 which can not, due to the lack of ; executive support, implement a function should return an ; error of -1 in r0. For instance, RT11 does not have any ; executive primitives to do wildcarding directory lookup. ; ; ; ; ; ASCDAT ( %loc buffer, %val datevalue ) ; ASCTIM ( %loc buffer, %val timevalue ) ; ASSDEV ( %loc device_name ) ; BINREA ( %val lun, %val timeout ) ; BINWRI ( %loc buffer, %val byte_count, %val lun ) ; CANTYP ( %loc device_name, %val lun ) ; CHKABO ( ) ; DODIR ( %loc directory_string, %val lun ) ; DRPPRV ( ) ; DSKUSE ( %loc returned_string ) ; ECHO ( %loc terminal_name ) ; EXIT ( ) ; GETPRV ( ) ; GETUIC ( ) ; GTTNAM ( %loc returned_ttname ) ; KBREAD ( %loc buffer ) ; L$PCRL ( ) ; L$TTYO ( %loc buffer, %val bytecount ) ; LOGOUT ( ) ; NAMCVT ( %loc source_filename, %loc returned_normal_name ) ; NOECHO ( %loc device_name, %val lun ) ; QUOCHK ( ) ; READ ( %loc buffer, %val buffer_length, %val lun, %val block_number ) ; SETCC ( %loc control_c_ast_handler ) ; SETSPD ( %loc device_name, %val speed ) ; SUSPEN ( %val seconds, %val ticks ) ; SYSERR ( %val error_number, %loc error_text_buffer ) ; TTRFIN ( ) ; TTRINI ( ) ; TTSPEE ( %loc terminal_name ) ; TTYDTR ( %loc terminal_name ) ; TTYFIN ( %loc terminal_name, %val lun ) ; TTYHAN ( %loc terminal_name ) ; TTYINI ( %loc terminal_name, %val lun, %val open_flags ) ; TTYPAR ( %loc terminal_name, %val parity_code ) ; TTYRST ( %loc terminal_name ) ; TTYSAV ( %loc terminal_name ) ; TTYSET ( %loc terminal_name ) ; WRITE ( %loc buffer, %val buffer_length, %val lun, %val block_number ) ; XINIT ( ) .sbttl define macros and local i/o database .if ndf, K11INC .ift .include /IN:K11MAC.MAC/ .endc .iif ndf,k11inc ,.error ; missing INCLUDE for K11MAC.MAC cr = 15 lf = 12 ff = 14 soh = 1 maxsiz = 1000 errbyt == 52 topmem = 50 JSW = 44 .enabl gbl .psect $code ,ro,i,lcl,rel,con .psect rtdir1 ,rw,d,gbl,rel,con .psect rtioda ,rw,d,lcl,rel,con ; Note that for RT11, of course, all files are considered ; to be image files. If there was a RMS11/RT we would have ; had transportability from RSX and RSTS version of disk ; i/o. buflst::.word ttbuf ,0 ,0 ,0 ,0 bufdef::.word ttbuf ,0 ,0 ,0 ,0 bufsiz::.word ttbsiz ,maxsiz ,maxsiz ,maxsiz ,maxsiz filtyp: .word terminal,text ,text ,text ,text bufp: .word 0 ,0 ,0 ,0 ,0 bufs: .word 0 ,0 ,0 ,0 ,0 mode: .word 1 ,0 ,0 ,0 ,0 blknum: .word 0 ,0 ,0 ,0 ,0 sizof: .word 0 ,0 ,0 ,0 ,0 filsiz == 100 defdir::.blkb filsiz+2 ; default directory for send and rec srcnam::.blkb filsiz+2 ; original send filespec filnam::.blkb filsiz+2 ; output from directory lookup routine asname::.blkb filsiz+2 ; for SEND file [as] file bintyp::.word 0 totp.s::.word 0,0 totp.r::.word 0,0 dkdev: .rad50 /DK / $hbufs == 1 ie.its == 0 fb$stm == 0 fb$var == 0 fb$cr == 0 xdorsx == 0 df$rfm::.word 0 df$rat::.word 0 ; /51/ The following buffers are allocated after the initial .SETTOP ; They can swap with the USR if need be. ALSIZE == 600 SDBSIZ == 600 $$LBUF == < <MAXLNG/10>+MAXLNG > & 177776 $$BUFP == <<MAXSIZ+2>*4> + $$LBUF + ALSIZE ttbsiz = 40 ttbuf: .blkb ttbsiz+2 $prtbu::.word ttbuf ; /51/ Altered at startup tsxsav::.word 0 devidx::.word 0 ; /45/ From .dstat, device type wtime: .word 0,60. cancel: mtsts: .word 0,0,0,0,0 timbuf: .word 0,0 timbf1: .word 0,0 clkflg::.word 0 tenth: .word 0,6 wasxc:: .word 0 jobsts::.blkw 10 ; /51/ From .GTJB freept::.word 0 ; /51/ For the next general allocation fetpt:: .word 0 ; /51/ For the next .FETCH fetptm::.word 0 ; /51/ Max address for fetching xmfetp::.word 0 ; /51/ Base of area for fetching, XM maxtop::.word 0 ; /51/ Size after .settop xklgbu::.word 0 ; /51/ Pointer to special XL buffer montyp::.word 0 ; /51/ < 0 -> SJ, = 0 -> FB, > 0 -> XM hilimi::.word 50 ; /51/ It's 50 for FB, $limit+2 for XM $ttyou::.word 0 ; /51/ Filled in at startup $$cbta::.word 0 ; /53/ $limit::.limit ; /51/ Enable XM .SETTOP .limit lun1 = 1 lun2 = 2 lun3 = 3 lun4 = 4 maxlun = lun4 .sbttl error mapping, error codes defined in overlay K11RTE .psect $pdata cloerr::.word er$sy1 ,er$sy1 ,er$sys ,er$prv csierr::.word er$fnm ,er$dev ,er$sy2 dsterr::.word er$dev enterr::.word er$lby ,er$ful ,er$sy3 ,er$prv ,er$sy3 feterr::.word er$dev ,er$sy4 lokerr::.word er$lby ,er$fnf ,er$sys reaerr::.word er$eof ,er$rer ,er$nop ,er$sys wrierr::.word er$eof ,er$wer ,er$nop ,er$sys twaerr::.word er$que mrkerr::.word er$que renerr::.word er$lby ,er$fnf ,er$iop ,er$prv xcierr::.word er$lby ,er$xco xcspfu::.word er$fun ,er$hrd ,er$nop ,er$sys .word er$sup faterr::.word fa$imp ,fa$nhd ,fa$dio ,fa$fet ,fa$ovr ,fa$dfl ,fa$adr .word fa$lun ,fa$imp ,fa$imp ,fa$imp ,fa$idr ,fa$imp ,fa$imp .word fa$imp ,fa$imp ,fa$imp ,fa$imp mterr:: .word er$nin ,er$nat ,er$lun ,er$iop ,er$bsy ,er$buf ,er$sys .word er$sup .psect $rtque nrtque == 20 rtque:: .blkw 10.*nrtque .psect $code .sbttl one shot init code for Kermit-11 RT11 CONFIG = 300 CONFG2 = 370 SYSGEN = 372 $USRLC = 266 SYSVER = 276 PRO350 = 20000 TSXPLU = 100000 SJSYS = 1 XMSYS = 10000 .MCALL .QSET,.TWAIT,.FETCH,.GVAL,.SETTOP,.SERR,.HERR,.GTIM .MCALL .DSTAT,.MTSTAT,.EXIT ; 23-May-86 18:21:33 XINIT moved to K11RTI.MAC GLOBAL <lun.in,lun.ou,proflg,rtvol,rtque,tsxflg> GLOBAL <defdir,infomsg> .sbttl open a file for rt11 .MCALL .CSISPC,.DSTATUS,.LOOKUP,.FETCH,.ENTER,.CLOSE .MCALL .SERR ,.HERR ,.PURGE .psect $code ; OPEN( &filename,channel,type ) ; ; CREATE( &filename,channel,type ) .psect $pdata defext: .word 0 .word 0 .word 0 .word 0 en$siz::.word 0 ; 1/2 largest free or 2nd largest .psect $code .enabl lsb fcreat:: ; Create a file append:: ; Alternate EP's create::mov #1 ,r0 ; Say we want to create br 10$ ; And off to common code fopen:: ; Open a file for reading open:: clr r0 ; .LOOKUP please 10$: Save <r1,r2,r3> ; Save these mov r0 ,r2 ; .ENTER/.LOOKUP ? mov (r5) ,r1 ; Filespec address, .Asciz mov 2(r5) ,r0 ; LUN mov 4(r5) ,r3 ; Binary/text call mtb$op ; Call file opener Unsave <r3,r2,r1> ; Pop em return ; And exit ; .dsabl lsb ; ; MTB$OP 20-Nov-86 14:56:59 BDN ; ; Input: R0 Lun ; R1 Filename, .asciz ; R2 Direction, zero --> read (.LOOKUP), else write (.ENTER) ; R3 Binary flag <> 0 --> binary ; Return: R0 Mapped error code ; ; This is the old open/create code from Kermit-11/RT rewritten for ; inclusion in another application. I have replaced the old code as ; this version is cleaner and 100 words shorter. .iif ndf, BINARY, BINARY = 1 .iif ndf, RD$ONL, RD$ONL = 0 .iif ndf, RD$WRI, RD$WRI = 1 .ASSUME RD$ONL EQ 0 .ASSUME BINARY EQ 1 Mtb$op::Save <r4,r5> ; Save regs (r1,r2,r3 saved above) sub #40.*2 ,sp ; Allocate a buffer for .CSISPC mov r0 ,r4 ; Copy the LUN to use .SERR ; Inhibit fatal aborts by RT asl r4 ; Zero? bne 10$ ; Non-zero mov sp ,mode+0 ; Zero, implies terminal always clr bufp+0 ; Clear this out also clr r0 ; No errors br 100$ ; Exit 10$: clr sizof(r4) ; Clear I/O subsystem tables clr bufp(r4) ; Clear buffer pointer out clr bufs(r4) ; Clear buffer size out clr mode(r4) ; Assume reading clr blknum(r4) ; To keep track of current VBN mov r3 ,filtyp(r4) ; Text or binary? mov bufdef(r4),r0 ; Insert default buffer addresses mov r0 ,buflst(r4) ; Copy it mov #MAXSIZ ,r5 ; Insert the buffer size mov r5 ,bufsiz(r4) ; Do it 20$: clrb (r0)+ ; Clear it out sob r5 ,20$ ; Next please mov sp ,r5 ; Point to save area 30$: movb (r1)+ ,(r5)+ ; Copy the filename over now bne 30$ ; Next please dec r5 ; Back up to the null. movb #'= ,(r5)+ ; Setup clrb @r5 ; .Asciz mov sp ,r5 ; Point back to save area mov #csierr ,r1 ; Assume .CSI error mapping .CSISPC r5,#defext,r5 ; Do it mov r5 ,sp ; Restore the stack pointer bcs 80$ ; Filename parse error tst @r5 ; Device name present? bne 40$ ; Yes mov #^RDK ,@r5 ; No, insert one then 40$: CALL fetch ; Insure that handlers are loaded tst r0 ; Well? bne 100$ ; No, error codes already mapped. mov r4 ,r3 ; Get channel number back asr r3 ; Get correct channel number tst r2 ; And check for .ENTER bne 50$ ; .ENTER ; mov #lokerr ,r1 ; Set up error mapping for .LOOKUP .LOOKUP #rtwork,r3,r5 ; Do it bcs 80$ ; It failed mov r0 ,sizof(r4) ; Success, return the created size mov #-1 ,bufp(r4) ; Force a disk read on first call. clr r0 ; Success br 100$ ; Exit ; 50$: tst 2(r5) ; Never allow NFS writes to a disk bne 60$ ; Its ok mov #^RNON ,2(r5) ; No name, stuff one in then mov #^RNAM ,4(r5) ; .... mov #^RTMP ,6(r5) ; ...... 60$: mov #enterr ,r1 ; Assume .ENTER error code mapping mov at$len ,r2 ; Is there a protocol passed size? bne 70$ ; Yes mov en$siz ,r2 ; No, use SET value or default. 70$: .ENTER #rtwork,r3,r5,r2 ; Try hard to create the file bcs 80$ ; No way mov sp ,mode(r4) ; Writing today clr r0 ; Success br 100$ ; Time to go now ; 80$: movb @#errbyt,r0 ; Get the error code bpl 90$ ; Normal error com r0 ; Hard error code mov #faterr ,r1 ; Map into the hard errors 90$: asl r0 ; Word addressing add r0 ,r1 ; Get the mapped (fake RMS) error asr r4 ; Channel number .PURGE r4 ; Insure the channel in cleared mov (r1) ,r0 ; Copy and exit 100$: mov r0 ,-(sp) ; Save errors .HERR ; Restore normal error handling mov (sp)+ ,r0 ; Pop add #40.*2 ,sp ; Pop stack Unsave <r5,r4> ; Pop registers and exit return getsiz::mov @r5 ,r1 ; get opened filesize asl r1 ; get the lun times 2 mov sizof(r1),r1 ; return the size clr r0 ; no errors return ; bye .sbttl close a file .MCALL .CLOSE ; C L O S E ; ; close (%val lun) ; ; input: @r5 channel number to close ; output: r0 mapped error code ; ; calls: flush(lun) close:: save <r1> ; save registers we may have call flush ; dump out any remaining buffer mov @r5 ,r1 ; then disconnect the access stream beq 10$ ; terminal .CLOSE r1 ; do the rt close bcc 10$ ; it worked movb @#errbyt,r0 ; it failed, map the rt11 error asl r0 ; to something more descriptive mov cloerr(r0),r0 ; simple br 20$ ; map the error please 10$: clr r0 ; no errors 20$: asl r1 ; channel number times 2 clr bufp(r1) ; buffer_pointer[lun] := 0 clr sizof(r1) ; no size please unsave <r1> ; pop the saved r1 return ; and exit with error in r0 rewind::mov @r5 ,r0 ; get the channel number beq 100$ ; for the terminal, a no-op asl r0 ; times two please mov #-1 ,bufp(r0) ; flag a buffer reload is needed clr bufs(r0) ; nothing is in the buffer clr blknum(r0) ; first block of the disk file 100$: clr r0 ; no errors are possible return ; bye .sbttl put a record to an rt11 sequential file ; P U T R E C ; ; putrec( %loc buffer, %val record_size, %val channel_number ) ; ; input: @r5 address of user buffer ; 2(r5) record size ; 4(r5) channel number ; ; output: r0 rms sts ; ; Write the next record to a disk file. ; ; Assumption: The record to be written will have a cr/lf ; appended to it unless the filetype is not ; text. In other words, PUTREC provides the ; carriage control unless the file is a ter- ; minal. putrec::save <r1,r2,r3> ; save registers we may need mov 2(r5) ,r2 ; the size of the i/o mov @r5 ,r3 ; the buffer address mov 4(r5) ,r1 ; the channel number please bne 10$ ; a real disk file tst r2 ; faking output to a terminal beq 100$ ; nothing at all to do ? print r3 ,r2 ; do the terminal i/o br 100$ ; bye 10$: tst r2 ; the size of the i/o to do beq 30$ ; nothing to do, add carriage control 20$: clr r0 bisb (r3)+ ,r0 ; the character to write out call putcr0 ; channel is passed in r1 tst r0 ; did the write fail ? bne 100$ ; yes, exit asap sob r2 ,20$ ; next ch please 30$: asl r1 ; get the channel number times 2 cmp filtyp(r1),#text ; is this a text file bne 100$ ; no, don't add carriage control in asr r1 ; get the channel number back movb #cr ,r0 ; and add in a cr/lf call putcr0 ; simple movb #lf ,r0 ; and at last the line feed call putcr0 ; do the line feed at the end 100$: unsave <r3,r2,r1> ; pop registers we saved return ; bye .sbttl getc get one character from an input file .MCALL .READW ; G E T C ; ; getc(%val channel_number) ; ; input: @r5 channel_number ; output: r0 rms error status ; r1 the character just read getc:: mov @r5 ,r0 call getcr0 return fgetcr::save <r3> ; use for saving the channel# 10$: mov r0 ,r3 ; save the channel number please call .getc ; get the next ch please tst r0 ; did the read work ok ? bne 100$ ; no, exit asl r3 ; get the channel number times 2 cmp filtyp(r3),#text ; if filetype[lun] = text bne 100$ ; then tstb r1 ; if ch = NULL bne 100$ ; then try-again asr r3 ; get origional channel back mov r3 ,r0 ; setup the correct call format br 10$ 100$: unsave <r3> return .getc: save <r2,r3> ; save temps mov r0 ,r2 ; channel number please mov r0 ,r1 ; for the .READW please asl r2 ; times 2 tst bufs(r2) ; anything in the buffer ? beq 10$ ; no, please load it cmp bufp(r2),#-1 ; need to initialize the buffer? bne 20$ ; no 10$: mov bufsiz(r2),r3 ; we need buffer size in words asr r3 ; convert bytes to words .READW #rtwork,r1,buflst(r2),r3,blknum(r2) bcs 90$ ; it failed, bye inc blknum(r2) ; next time read the next block clr bufp(r2) ; it worked. clear current pointer asl r0 ; convert words read to bytes mov r0 ,bufs(r2) ; and save the record size 20$: mov buflst(r2),r3 ; get the address of the buffer add bufp(r2),r3 ; and point to the next character clr r1 ; to be returned in r1 bisb @r3 ,r1 ; simple inc bufp(r2) ; buffer.pointer := succ(buffer.pointer) dec bufs(r2) ; amountleft := pred( amountleft ) clr r0 ; no errors please br 100$ 90$: movb @#errbyt,r0 ; get the error code asl r0 ; times two mov reaerr(r0),r0 ; map it into a unique global error 100$: unsave <r3,r2> return .sbttl putc put a single character to an rms file .MCALL .WRITW ; P U T C ; ; input: @r5 the character to put ; 2(r5) the channel number to use ; ; Buffer single character i/o to internal disk buffer. ; Buffer is dumped if internal buffer is full. ; The local buffers are allocated in CREATE and OPEN. putc:: save <r1> ; simply save r1 and call putcr0 mov 2(r5) ,r1 ; to do it. putcr0 will be somewhat clr r0 ; faster to call directly due to the bisb @r5 ,r0 ; overhead involved in setting up an call putcr0 ; argument list. unsave <r1> ; pop saved r1 and exit return ; bye putcr0::save <r1,r2,r3,r4> ; save registers we use mov r1 ,r2 ; channel number asl r2 ; times 2 of course cmp bufp(r2),bufsiz(r2) ; is the buffer full ? blo 20$ ; no, store some more characters in it movb r0 ,r3 ; yes, save the input character r0 mov bufsiz(r2),r4 ; and setup for a .WRITW asr r4 ; rt11 needs word count not byte count tst r1 ; channel zero is always terminal beq 3$ ; simple cmp filtyp(r2),#terminal ; check for being a terminal today? bne 4$ ; not a terminal 3$: print buflst(r2),bufsiz(r2) ; a terminal, force it out please br 5$ ; and reinit the buffer now 4$: .WRITW #rtwork,r1,buflst(r2),r4,blknum(r2); dump this block to disk bcs 90$ ; it failed for some reason 5$: inc blknum(r2) clr bufp(r2) ; pointer := 0 mov buflst(r2),r4 ; it worked. zero the buffer now mov bufsiz(r2),r0 ; get the buffer address and size 10$: clrb (r4)+ ; for i := 1 to bufsiz sob r0 ,10$ ; do buffer[i] := chr(0) movb r3 ,r0 ; ok, restore the old character 20$: mov bufp(r2),r1 ; get the current buffer pointer add buflst(r2),r1 ; and point to a new home for the movb r0 ,@r1 ; the input character in r0 inc bufp(r2) ; pointer := succ( pointer ) clr r0 ; success br 100$ 90$: movb @#errbyt,r0 ; get the rt11 error code asl r0 ; times two mov wrierr(r0),r0 ; map it into a global error code 100$: unsave <r4,r3,r2,r1> return .sbttl flush .MCALL .WRITW flush: save <r1,r2> mov @r5 ,r1 ; get the internal channel number asl r1 ; times 2 for indexing tst bufp(r1) ; anything in the buffer beq 100$ ; no tst mode(r1) ; writing today ? beq 100$ ; no tst r1 ; terminal today ? beq 20$ ; yes mov bufsiz(r1),r2 ; rt11 likes to have word counts asr r2 ; simple .WRITW #rtwork,@r5,buflst(r1),r2,blknum(r1) br 100$ 20$: print buflst(r1),bufp(r1) br 100$ 100$: unsave <r2,r1> clr r0 return .sbttl fparse parse filename and fill in with defaults ; F P A R S E ; ; input: @r5 input filename, .asciz ; defdir the default directory name string to use ; ; output: 2(r5) expanded filename, .asciz, maximum length 63 bytes ; r0 error codes ; ; For RT11, simply return the passed string. Perhaps later do ; something real. fparse::save <r1> mov #defdir ,r0 mov 2(r5) ,r1 10$: movb (r0)+ ,(r1)+ bne 10$ dec r1 copyz @r5 ,r1 ; simple clr r0 ; no errors are possible today unsave <r1> return ; bye global <defdir> .sbttl l$ttyout ; Print a string to the console terminal ; ; Input: @r5 buffer address ; 2(r5) string length ; ; If 2(r5) is zero, then assume .asciz .if eq ,0 .ift l$ttyo::call @$ttyou return .iff l$ttyo::save <r0,r1,r2,r3> ; save registers we may need mov @r5 ,r1 ; get the string address mov 2(r5) ,r2 ; get the string length bne 20$ ; non-zero then mov r1 ,r2 ; count until a null now 10$: tstb (r2)+ ; well ? bne 10$ ; not yet, keep looking sub r1 ,r2 ; get the length now dec r2 ; all done beq 100$ ; nothing to print at all? 20$: mov $prtbuf ,r0 ; now buffer the i/o to avoid mov #36 ,r3 ; the printing of cr/lf at the 30$: tstb (r1)+ ; don't copy nulls please beq 35$ ; ignore if null movb -1(r1) ,(r0)+ ; copy a byte please 35$: dec r2 ; done yet ? beq 40$ ; yes sob r3 ,30$ ; no, next please 40$: movb #200 ,(r0)+ ; insure no carraige control ! clrb @r0 ; must be passed .asciz mov $prtbuf ,r0 ; point back to the start of buffer emt 351 ; do the .print kmon request tst r2 ; any more data to buffer ? bne 20$ ; yes, try again 100$: unsave <r3,r2,r1,r0> return .endc l$pcrl::print #100$ return 100$: .byte cr,lf,0,0 ; G E T S Y S ; ; output: r0 operating system ; ; sy$11m (1) for rsx11m ; sy$ias (3) for ias ; sy$rsts (4) for rsts ; sy$mpl (6) for m+ ; sy$rt (7) for rt11 ???? getsys::mov #7 ,r0 ; this is rt11 folks return ; bye .sbttl misc routines iswild::mov @r5 ,r0 10$: tstb @r0 beq 100$ cmpb @r0 ,#'% beq 90$ cmpb (r0)+ ,#'* bne 10$ 90$: mov #1 ,r0 return 100$: clr r0 return ; E X I T ; ; exit to kmon .MCALL .EXIT ,.HRESET,.CMKT ,.TWAIT exit:: .CMKT #cancel,#0 ; /51/ Stop watchdogs please call finrt ; /37/ clear lines out clr r0 .EXIT ; should always work ok halt ; huh ? .MCALL .TWAIT ; mark time request suspen::save <r1> ; save temps mov @r5 ,r1 ; sleep time in seconds beq 10$ ; nothing, must be fractional mul #60. ,r1 ; sixty clock ticks in a second clr r0 ; low order part br 20$ ; ignore the fractional part 10$: mov 2(r5) ,r0 ; sleep < 1 second 20$: add r1 ,r0 ; total time to sleep mov r0 ,-(sp) ; setup the timeout block clr -(sp) ; two words please mov sp ,r1 ; point to it .TWAIT #rtwork,r1 ; suspend ourself for a while bcs 30$ ; it worked ok clr r0 ; return success br 100$ ; bye 30$: movb @#errbyt,r0 ; it failed, map the error into asl r0 ; a global error number mov twaerr(r0),r0 ; simple 100$: cmp (sp)+ ,(sp)+ ; pop time buffer and exit unsave <r1> ; pop registers return ; bye .sbttl Log out and Set control C logout::tst tsxsav ; /45/ Does this make sense? beq 100$ ; /45/ Not really mov #510 ,r0 ; /45/ Address of chain command mov #4 ,(r0)+ ; /45/ Setup to log out on TSX+ movb #'B&137 ,(r0)+ ; /45/ And insert BYE movb #'Y&137 ,(r0)+ ; /45/ ... movb #'E&137 ,(r0)+ ; /45/ ... clrb (r0)+ ; /45/ Make it .asciz please bis #4000 ,@#JSW ; /45/ Pass to KMON clr r0 ; /45/ Must be zero .EXIT ; /45/ Try to logout on TSX+ 100$: clr r0 ; /45/ Exit return .MCALL .SCCA ,.MRKT ,.EXIT ,.CMKT ,.RCTRLO,.SPCPS ,.TTINR .save ; /51/ Save current PSECT .psect sccada ,rw,d,lcl,rel,con;/51/ Get out of APR1 mapping? sccwork:.word 0,0,0,0 ; /51/ A work area for .SCCA ccflag: .word 0 ; /51/ RT11's way of flagging ^C mkw: .word 0,0,0,0 ; /51/ A Mark Time work area mktime: .word 0,15. ; /51/ Check for ^C every 15 ticks spcwork:.word 0,0 ; /51/ For the .SPCPS directive spcarg: .word ccexit,0,0 ; /51/ Where to alter flow to. .restore ; /51/ Pop old psect now. .save ; /51/ Save current PSECT .psect sccain ,ro,i,lcl,rel,con;/51/ Perhaps get this out of APR1 .enabl lsb ; /51/ mapping for XM? setcc:: clr ccflag ; /51/ No control C's as of yet .CMKT #mkw,#40 ; /51/ Clear previous Mark Time. .SCCA #sccwork,#ccflag ; /51/ Set the address for flag word .MRKT #mkw,#mktime,#ccast,#40 ; /51/ Schedule a checkup for ^C return ; /51/ Exit ccast: tst ccflag ; /51/ Was there a Control C typed? beq 100$ ; /51/ No, just reschedule clr ccflag ; /51/ Clear the flag .TTINR ; /51/ In case control C's sitting .TTINR ; /51/ around in the input buffer. .RCTRLO ; /51/ Insure output enabled inc cccnt ; /51/ Bump the global ^C count cmp cccnt ,#CC$MAX ; /51/ Exit? blos 100$ ; /51/ No call finrt ; /51/ Yes, get set to exit .SPCPS #spcwork,#spcarg ; /51/ Get RT11 to jump to .EXIT bcc 110$ ; /51/ Success 10$: clr r0 ; /51/ Normal .EXIT .EXIT ; /51/ Bye 100$: .MRKT #mkw,#mktime,#ccast,#40 ; /51/ Start a timer to watch 110$: return ; /51/ And exit ccexit: .EXIT ; /51/ Bye .dsabl lsb ; /51/ .restore .sbttl Dummy EPTS for RSTS/RSX compatibility putcdt:: getcdt:: tlog:: tmsdia:: getuic:: quochk:: qspool:: noecho:: echo:: chkpar:: fixwil:: putatr:: runjob::clr r0 getprv:: drpprv:: throtl::return binfil::clr r0 calls chkext ,<@r5> return getatr:: detach:: systat:: login:: sercmd::mov #er$iop ,r0 return okuser::mov (sp)+ ,@sp return dskuse::mov @r5 ,r0 clrb @r0 return second::clr r0 clr r1 return getpro::clr r0 return getmcr::mov @r5 ,r0 clrb @r0 clr r0 return .sbttl FETCH Load a handler if not already resident (BG only) ; FETCH( rad50(devicename) ) ; ; Mostly rewritten Edit /51/ ; ; /51/ Hard error recovery ; /51/ New buffer allocation scheme ; /51/ Checks on .FETCH when running in Foreground ; ; Example call: CALLS FETCH,<#^RDZ0> ; TST R0 ; BNE ERROR fetch:: .SERR ; Trap all errors please .DSTAT #rtwork,r5 ; Get handler status bcs 70$ ; No such handler present movb rtwork ,devidx ; Save device index tst rtwork+4 ; Is this handler resident ? bne 50$ ; Yes tst jobsts ; No, we MUST be job zero to be in bne 55$ ; the background, else ERROR return. mov fetptmax,-(sp) ; Check for space to load it sub @fetpt ,@sp ; Simple to do cmp rtwork+2,(sp)+ ; Is there sufficient space ? bhi 60$ ; No, error and exit .FETCH @fetpt ,r5 ; Try hard to load the thing bcs 80$ ; No way, map the error code please mov r0 ,@fetpt ; update the free pointer and exit 50$: clr r0 ; No errors br 100$ ; Exit ; 55$: mov #ER$FGF ,r0 ; Can't fetch if running in FG br 100$ ; Exit 60$: mov #ER$FET ,r0 ; Return NO ROOM for the handler br 100$ ; and exit with error in R0. ; 70$: mov #DSTERR ,-(sp) ; Map a .dstat error br 90$ ; And do it 80$: mov #FETERR ,-(sp) ; Map a .FETCH error 90$: movb @#ERRBYT,r0 ; Get the error code bpl 95$ ; Normal error code here com r0 ; Fatal error from .SERR mov #FATERR ,(sp) ; Thus map to RT11 messages 95$: asl r0 ; Word offsets add (sp)+ ,r0 ; The actual address mov @r0 ,r0 ; Get it and exit 100$: mov r0 ,-(sp) ; Save this .HERR ; Reset executive error trapping mov (sp)+ ,r0 ; Restore error codes return ; Bye .sbttl things to do eis instructions $cbta:: jsr pc ,@$$cbta return .if ne ,0 .ift .psect $mul:: mov r0 ,-(sp) mov r1 ,-(sp) mov 6(sp) ,r0 mov 10(sp) ,r1 mov r0,-(sp) mov #21,-(sp) clr r0 10$: ror r0 ror r1 bcc 20$ add 2(sp),r0 20$: dec (sp) bgt 10$ cmp (sp)+ ,(sp)+ mov r1 ,10(sp) mov (sp)+ ,r1 mov (sp)+ ,r0 mov (sp) ,2(sp) tst (sp)+ return $div:: mov r0 ,-(sp) mov r1 ,-(sp) mov 6(sp) ,r0 mov 10(sp) ,r1 mov #20,-(sp) mov r1,-(sp) clr r1 e00040: asl r0 rol r1 cmp r1,(sp) bcs e00054 sub (sp),r1 inc r0 e00054: dec 2(sp) bgt e00040 cmp (sp)+ ,(sp)+ mov r1 ,6(sp) mov r0 ,10(sp) mov (sp)+ ,r1 mov (sp)+ ,r0 return .endc .sbttl $CBTA Conversion called by $CDDMG from RSX SYSLIB ; 09-Jun-86 10:14:54 $CBTA moved to K11DSP.MAC for XM root cuts .GLOBL $SAVRG ;Global reference .GLOBL $CBTA .GLOBL $SAVRG $SAVRG: MOV R4,-(SP) MOV R3,-(SP) MOV R5,-(SP) MOV 6(SP),R5 CALL @(SP)+ MOV (SP)+,R3 MOV (SP)+,R4 MOV (SP)+,R5 RETURN .end